Attribute VB_Name = "modEmail"
'------------------------------------------------------------------------------
'Module Name:   modEmail
'Author:        Chris Elwell
'Date:          3/6/2006
'Version:       1.0.0
'Description:   Contains Email building/sending routines, log file routines,
'               and transit time calculation routines.
'Procedures:
'               BuildEmail          'Build the Ship Alert Email
'               DeleteEmailFile     'Deletes the Email files
'               DeleteEmailFolder   'Deletes the Email folder
'               LoadEmailText       'Reads in the HTML Template and returns a string
'               ProcessEmails       'Loops through Email directory to send Emails
'               ReplaceToken        'Replaces the tokens in the template with actual text
'               SendEmail           'Sends an Email
'               StartEmail          'Begins the processing of sending/deleting Emails
'               WriteLogStart       'Write the beginning of the log file
'               WriteLogEnd         'Writes the end of the log file
'               WriteLogFile        'Writes log text
'------------------------------------------------------------------------------
Option Explicit
Option Compare Text
'---------------------------------------------------------------------------------------
' Procedure : BuildEmail
' DateTime  : 01/20/2004
' Purpose   : Loads the Email template and builds the Email for the pkg.
'---------------------------------------------------------------------------------------
'
Public Sub BuildEmail(ByVal str29 As String)
    
    Dim strEmailTextIn As String
    Dim strEmailTextOut As String
    Dim strEmailFolder As String
    
    Dim FSO As New Scripting.FileSystemObject
    Dim TSO As Scripting.TextStream
    
    On Local Error GoTo EH
    
    strEmailFolder = App.Path & "\Email\PendingEmails\"
    strEmailTextIn = LoadEmailText(App.Path & "\Email\" & "EmailTemplate.htm")
            
    'Build Email text
    'Recipient Email
    strEmailTextOut = g_str1202 & vbCrLf
    'Sender Email
    strEmailTextOut = strEmailTextOut & g_str1201 & vbCrLf
    
    '07/12/06 Add Sender Email to CC line if Shipment Notification is checked
    If g_str1554 <> "" Then
        strEmailTextOut = strEmailTextOut & g_str1201 & ";"
    End If
    
    'Other 1, 2, & 3 if provided
    If g_str1204_1 <> "" Then
        strEmailTextOut = strEmailTextOut & g_str1204_1
        If g_str1204_2 <> "" Then
            strEmailTextOut = strEmailTextOut & ";" & g_str1204_2
            If g_str1204_3 <> "" Then
                strEmailTextOut = strEmailTextOut & ";" & g_str1204_3 & vbCrLf
            Else
                strEmailTextOut = strEmailTextOut & vbCrLf
            End If
        Else
            strEmailTextOut = strEmailTextOut & vbCrLf
        End If
    Else
        strEmailTextOut = strEmailTextOut & vbCrLf
    End If
    '20070326-01 Added [SDRCompany] to Email Subject with trk#
    strEmailTextOut = strEmailTextOut & "[SDRCOMPANY] Shipment Notification, " & str29 & vbCrLf
    
    'Use alt return company if selected else use server config
    If g_str1586 = "Y" And g_str1486 <> "" Then
        strEmailTextOut = strEmailTextOut & ReplaceToken(strEmailTextIn, g_str1486, "[SDRCOMPANY]")
        strEmailTextOut = ReplaceToken(strEmailTextOut, g_str1486, "[SDRCOMPANY]")
    Else
        strEmailTextOut = strEmailTextOut & ReplaceToken(strEmailTextIn, g_str4, "[SDRCOMPANY]")
        strEmailTextOut = ReplaceToken(strEmailTextOut, g_str4, "[SDRCOMPANY]")
    End If
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str24, "[SHIPDATE]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str11, "[COMPANY]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str12, "[CONTACT]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str13, "[ADDR1]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str15, "[CITY]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str16, "[STATE]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str17, "[ZIP]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str1670, "[WEIGHT]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, str29, "[TRACKNO]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, str29, "[TRACKNO]")
    '20070326-02 Uncommented this line.
    strEmailTextOut = ReplaceToken(strEmailTextOut, frmSetup.txtCustID, "[CUSTID]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str25, "[REF]")
    strEmailTextOut = ReplaceToken(strEmailTextOut, g_str1203, "[MESSAGE]")
    strEmailTextOut = strEmailTextOut & vbCrLf & "</BODY></HTML>"
    
    If Not FSO.FolderExists(strEmailFolder) Then
        FSO.CreateFolder (strEmailFolder)
    End If
    Set TSO = FSO.CreateTextFile(strEmailFolder & "\" & str29 & ".htm")
    
    'Write the html text to the Email file
    TSO.Write strEmailTextOut
    TSO.Close

Release:
    Set TSO = Nothing
    Set FSO = Nothing
    Exit Sub
EH:
    Call WriteLogFile("Error in " & "modEmail:BuildEmail" & " " & Err.Description)
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadEmailText
' DateTime  : 12/22/2003
' Purpose   : Loads the Email text saved in Email templates
'---------------------------------------------------------------------------------------
'
Private Function LoadEmailText(ByVal strFilePath As String) As String

    Dim FSO As New Scripting.FileSystemObject
    Dim TSO As Scripting.TextStream
    Dim strInput As String

    On Local Error GoTo EH
    
    strInput = ""
    
    If Not FSO.FileExists(strFilePath) Then
        MsgBox "Email Template Not Found: " & strFilePath, vbCritical, "Email Creation Error"
    Else
        Set TSO = FSO.OpenTextFile(strFilePath, ForReading)
    
        'Read in all lines in template
        Do While Not TSO.AtEndOfStream
            strInput = strInput & TSO.ReadLine
        Loop
    
        TSO.Close
    End If

    LoadEmailText = strInput

Release:
    Set FSO = Nothing
    Set TSO = Nothing
    Exit Function
EH:
    Call WriteLogFile("Error in " & "modEmail:LoadEmailText" & " " & Err.Description)
    Resume Release
    
End Function
'---------------------------------------------------------------------------------------
' Procedure : ReplaceToken
' DateTime  : 12/22/2003
' Purpose   : Replaces the variables in Email templates with the actual values. Arguments
'             are the text to search, actual values, and variables (tokens) to search for.
'---------------------------------------------------------------------------------------
'
Private Function ReplaceToken(ByVal strTextIN As String, _
                                ByVal strReplaceText As String, _
                                ByVal strToken As String) As String
    
    Dim lngPos As Long
    Dim strTextOUT As String

    On Local Error GoTo EH
    
    'Set the position of the token in the text
    lngPos = InStr(1, strTextIN, strToken)
    'If token found, replace with actual value
    If lngPos > 0 Then
        'Get text from strTextIN up to token
        strTextOUT = Left(strTextIN, lngPos - 1)
        'Add actual value
        strTextOUT = strTextOUT & strReplaceText
        'Add text from strTextIN after the token
        strTextOUT = strTextOUT & (Right(strTextIN, Len(strTextIN) - (lngPos + Len(strToken)) + 1))
    Else
        strTextOUT = strTextIN
    End If

    ReplaceToken = strTextOUT

    Exit Function
EH:
    Call WriteLogFile("Error in " & "modEmail:ReplaceToken" & " " & Err.Description)

End Function
'---------------------------------------------------------------------------------------
' Procedure : StartEmail
' DateTime  : 2/05/2004
' Purpose   : Set path for Emails and calls sub to send Emails and then delete Emails
'---------------------------------------------------------------------------------------
'
Public Sub StartEmail()
    Dim strEmailsPath
    Dim FSO As New Scripting.FileSystemObject
    
    On Local Error GoTo EH
    
    strEmailsPath = App.Path & "\Email\PendingEmails"
    
    If FSO.FolderExists(strEmailsPath) Then
        Call ProcessEmails(strEmailsPath & "\")
        Call DeleteEmailFile(strEmailsPath & "\*.*")
    End If

Release:
    Set FSO = Nothing
    Exit Sub
EH:
    Call WriteLogFile("Error in " & "modEmail:StartEmail" & " " & Err.Description)
    Resume Release
    

End Sub
'---------------------------------------------------------------------------------------
' Procedure : ProcessEmails
' DateTime  : 1/05/2004
' Purpose   : Loops through all the files in a directory. Creates the Email then calls the
'             the SendEmail sub.
'---------------------------------------------------------------------------------------
'
Private Sub ProcessEmails(ByVal strPath As String)
    
    Dim strEmails As String
    Dim strTo As String
    Dim strFrom As String
    Dim strCC As String
    Dim strSubject As String
    Dim strEmailBody As String
    Dim lngEmailCount As Long
    Dim FSO As New Scripting.FileSystemObject
    Dim TSO As Scripting.TextStream


    On Local Error GoTo EH
    
    'Get a listing of all HTM files in Email directory
    strEmails = Dir(strPath & "\*.HTM")
    lngEmailCount = 0
    'Write log start time info
    Call WriteLogStart
    'Loop through the listing of HTM files
    Do While strEmails <> ""
        Set TSO = FSO.OpenTextFile(strPath & strEmails, ForReading)
        'Get To, From, CC and Subject from first 4 lines of the file
        strTo = TSO.ReadLine
        strFrom = TSO.ReadLine
        strCC = TSO.ReadLine
        strSubject = TSO.ReadLine
        
        strEmailBody = ""
        
        'Get the Email body
        Do Until TSO.AtEndOfStream
            strEmailBody = strEmailBody & TSO.ReadLine
        Loop
        TSO.Close
        
        'Send Email
        Call SendEmail(strTo, strFrom, strCC, strSubject, strEmailBody)
        
        'Increment counter
        lngEmailCount = lngEmailCount + 1
        
        'Get next Email filename
        strEmails = Dir()
    Loop
    'Write log end time and total Emails
    Call WriteLogEnd(lngEmailCount)
    
Release:
    Set FSO = Nothing
    Set TSO = Nothing
    Exit Sub
EH:
    Call WriteLogFile("Error in " & "modEmail:ProcessEmails" & " " & Err.Description)
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : SendEmail
' DateTime  : 1/05/2004
' Purpose   : Sends an Email
'---------------------------------------------------------------------------------------
'
Private Sub SendEmail(ByVal strEmailTo As String, _
                      ByVal strEmailFrom As String, _
                      ByVal strCC As String, _
                      ByVal strEmailSubject As String, _
                      ByVal strEmailBody As String)

    Dim MyMailerObject As CDO.Message
    
    On Local Error GoTo EH
    
    'Create mail object
    Set MyMailerObject = CreateObject("CDO.Message")
    'Add mail fields and text then send
    With MyMailerObject
    
        'If From is an empty string pass a default Email address
        .From = IIf(strEmailFrom <> "", strEmailFrom, "DoNotReply@shipper.com")
        .To = strEmailTo
        .CC = strCC
        .Subject = strEmailSubject
        .MimeFormatted = True
        .HTMLBody = strEmailBody
        .Send
    End With

Release:
    Set MyMailerObject = Nothing
    Exit Sub
EH:
    Call WriteLogFile("Error in " & "modEmail:SendEmail" & " " & Err.Description)
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : WriteLogStart
' DateTime  : 1/05/2004
' Purpose   : Writes the start time in a log
'---------------------------------------------------------------------------------------
'
Private Sub WriteLogStart()
    
    On Local Error GoTo EH
    
    WriteLogFile ("Begin Processing Time: " & Time)
    WriteLogFile ("Shipment Date: " & Date)

    Exit Sub
EH:
    Call WriteLogFile("Error in " & "modEmail:WriteLogStart" & " " & Err.Description)
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : WriteLogEnd
' DateTime  : 1/05/2004
' Purpose   : Writes the number of Emails sent and end time in the log.
'---------------------------------------------------------------------------------------
'
Private Sub WriteLogEnd(ByVal lngCount As Long)
    
    On Local Error GoTo EH
    
    WriteLogFile ("Number Emails Sent: " & Str(lngCount))
    WriteLogFile ("End Processing Time: " & Time)
    WriteLogFile ("------------------------------------------")

    Exit Sub
EH:
    Call WriteLogFile("Error in " & "modEmail:WriteLogEnd" & " " & Err.Description)
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : WriteLogFile
' DateTime  : 1/05/2004
' Purpose   : Writes a line in the log.
'---------------------------------------------------------------------------------------
'
Private Sub WriteLogFile(ByVal strText As String)

    Dim FSO As New Scripting.FileSystemObject
    Dim TSO As Scripting.TextStream

    On Error Resume Next
    
    Set TSO = FSO.OpenTextFile(App.Path & "\Email\Email.log", ForAppending, True)
    TSO.Write (Date & " " & Time & " : " & strText & vbCrLf)
    TSO.Close
    
    Set FSO = Nothing
    Set TSO = Nothing
   
End Sub
'---------------------------------------------------------------------------------------
' Procedure : DeleteEmailFile
' DateTime  : 3/07/2006
' Purpose   : Deletes an Email file.
'---------------------------------------------------------------------------------------
'
Public Sub DeleteEmailFile(ByVal strFilePath As String)
    
    Dim FSO As New Scripting.FileSystemObject
    
    On Local Error GoTo EH
    
    FSO.DeleteFile strFilePath

Release:
    Set FSO = Nothing
    Exit Sub
EH:
    Call WriteLogFile("Error in " & "modEmail:DeleteEmailFile" & " " & Err.Description)
    Resume Release
    
End Sub
